home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
program
/
4th86_v4.zip
/
PUZZLE.4TH
< prev
next >
Wrap
Text File
|
1994-01-04
|
3KB
|
109 lines
off printload
( forget strt
: strt ; )
( using puzzle.4th )
unsplit cls
( This is a program which was written hurriedly one evening to help with my
daughter's homework problem. If anything -- it shows the perils of not
documenting things at the moment they are written. The exact specification of
the problem we can no longer recall -- other than that it involves finding
" magic numbers" such that they can be split into integral divisors - which
divisors add up to that number.
For example 496 = 1 + 2 + 4 + 8 + 16 + 248 + 124 + 62 + 31
where (2 x 248) = (4 x 124) = (8 x 62) = (16 x 31) = 496
In fact it was a futile exercise as the next highest number is so
very large that it probably exceeds single precision range. Also -- there is
allegedly only one such additional number feasible.
Be assured there is just ONE more number -- and it's VERY large --
and maybe use this as an exercise in converting the program to double
precision -- or inventing a different algorithm. )
( ) 20 const range
( ) 60 block valid
( ) 2 block ptr1
( ) 2 block sum
2 block orig
( *******
store valid value in array and update pointers
********* )
: store valid dup 1 swap +! ( inc count )
ptr1 @ + ! ( store result )
2 ptr1 +! ( inc ptr1 ) ;
( *******
see if input numbers divide exactly - if so store in array
********* )
: htest swap over /mod drop 0= if ( exact div -- NOS=number TOS=div )
over over = 0= if store else drop then
else drop then ;
( *******
test input number with divisors from 2 through "range"
********* )
: primes range 2 do dup i htest loop ( drop ) ;
( *******
initialise variables
********* )
: init 58 0 do 0 valid i + ! 2 +loop 1 sum !
2 ptr1 ! ( first word is count ) dup orig ! ;
( *******
do division again to get other divisor
********* )
: others valid @ dup + 2 do dup valid i + @ / dup range > if store
else drop
then 2 +loop ;
( *******
display contents of array "valid"
********* )
: show valid @ dup + 2 do valid i + @ . ( crlf ) 2 +loop ;
( *******
add numbers in array
********* )
: hadd valid @ dup + 2 do valid i + @ sum +! 2 +loop ;
( *******
display results for value passed in
********* )
: tst init
primes others drop
hadd sum @ orig @ - 0= if 1 . show orig @
" gives number " crlf ." . crlf then ;
( *******
scan and TST numbers 1 through value passed in
********* )
: cdoit crlf 1 do i tst loop ;
( *******
debugging stub -- display results for input number
********* )
: parts init ( first word is count )
dup orig ! primes others drop 1 . show hadd crlf sum @ " sum is " ." .
;
on printload
1500 cdoit